{2}{4}{$C-,A+,D-}DEBUG{$C+,D+}GUBED PROGRAM TANGLE(INPUT,OUTPUT,POOL,TTY
);LABEL 9999;CONST{7}BUFSIZE=100;MAXBYTES=30000;MAXTOKS=65535;MAXNAMES=
4000;MAXTEXTS=2000;HASHSIZE=353;LONGESTNAME=300;LINELENGTH=72;OUTBUFSIZE
=144;STACKSIZE=50;MAXIDLENGTH=12;UNAMBIGLENGT=7;TYPE{11}ASCIIFILE=FILE
OF CHAR;ASCIICODE=0..127;{26}EIGHTBITS=0..255;SIXTEENBITS=0..65535;{28}
NAMEPOINTER=0..MAXNAMES;{31}TEXTPOINTER=0..MAXTEXTS;{65}OUTPUTSTATE=
RECORD ENDFIELD:SIXTEENBITS;BYTEFIELD:SIXTEENBITS;NAMEFIELD:NAMEPOINTER;
REPLFIELD:TEXTPOINTER;END;VAR{12}POOL:ASCIIFILE;{14}BUFFER:ARRAY[0..
BUFSIZE]OF ASCIICODE;{16}PHASEONE:BOOLEAN;{27}BYTEMEM:PACKED ARRAY[0..
MAXBYTES]OF ASCIICODE;TOKMEM:PACKED ARRAY[0..MAXTOKS]OF EIGHTBITS;
BYTESTART:ARRAY[0..MAXNAMES]OF SIXTEENBITS;TOKSTART:ARRAY[0..MAXTEXTS]OF
SIXTEENBITS;LINK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;ILK:ARRAY[0..MAXNAMES]
OF SIXTEENBITS;EQUIV:ARRAY[0..MAXNAMES]OF SIXTEENBITS;TEXTLINK:ARRAY[0..
MAXTEXTS]OF SIXTEENBITS;{29}NAMEPTR:NAMEPOINTER;STRINGPTR:NAMEPOINTER;
BYTEPTR:0..MAXBYTES;{32}TEXTPTR:TEXTPOINTER;TOKPTR:0..MAXTOKS;STAT
MAXTOKPTR:0..MAXTOKS;TATS{37}IDFIRST:0..BUFSIZE;IDLOC:0..BUFSIZE;
DOUBLECHARS:0..BUFSIZE;HASH,CHOPHASH:ARRAY[0..HASHSIZE]OF SIXTEENBITS;
CHOPPEDID:ARRAY[0..UNAMBIGLENGT]OF ASCIICODE;{52}MODULE:ARRAY[0..
LONGESTNAME]OF ASCIICODE;{57}LASTUNNAMED:TEXTPOINTER;{66}CURSTATE:
OUTPUTSTATE;STACK:ARRAY[1..STACKSIZE]OF OUTPUTSTATE;STACKPTR:0..
STACKSIZE;{68}BRACELEVEL:EIGHTBITS;{72}CURVAL:INTEGER;{80}OUTBUF:ARRAY[0
..OUTBUFSIZE]OF ASCIICODE;OUTPTR:0..OUTBUFSIZE;BREAKPTR:0..OUTBUFSIZE;{
81}OUTSTATE:EIGHTBITS;OUTVAL,OUTAPP:INTEGER;OUTSIGN:ASCIICODE;{86}
OUTCONTRIB:ARRAY[1..LINELENGTH]OF ASCIICODE;{108}PAGE:SIXTEENBITS;LINE:
SIXTEENBITS;LIMIT:0..BUFSIZE;LOC:0..BUFSIZE;INPUTHASENDE:BOOLEAN;{116}
CURMODULE:NAMEPOINTER;{127}NEXTCONTROL:EIGHTBITS;{134}CURREPLTEXT:
TEXTPOINTER;{140}MODULECOUNT:0..12287;{148}DEBUG TROUBLESHOOT:BOOLEAN;
DDT:SIXTEENBITS;DD:SIXTEENBITS;GUBED{17}DEBUG PROCEDURE DEBUGHELP;
FORWARD;GUBED{18}PROCEDURE ERROR;VAR{19}K,L:0..BUFSIZE;{21}J:0..
OUTBUFSIZE;BEGIN IF PHASEONE THEN{20}BEGIN WRITELN(TTY,'. (p.',PAGE:0,
',l.',LINE:0,')');IF LOC>=LIMIT THEN L:=LIMIT ELSE L:=LOC;FOR K:=1 TO L
DO IF BUFFER[K-1]=9 THEN WRITE(TTY,' ')ELSE WRITE(TTY,CHR(BUFFER[K-1]));
WRITELN(TTY,'');FOR K:=1 TO L DO WRITE(TTY,' ');FOR K:=L+1 TO LIMIT DO
WRITE(TTY,CHR(BUFFER[K-1]));WRITE(TTY,' ');END ELSE{22}BEGIN WRITELN(TTY
,'. (l.',LINE:0,')');FOR J:=1 TO OUTPTR DO WRITE(TTY,CHR(OUTBUF[J-1]));
WRITE(TTY,'...');END;DEBUG DEBUGHELP;GUBED END;{23}PROCEDURE QUIT;BEGIN
GOTO 9999;END;PROCEDURE INITIALIZE;VAR{38}H:0..HASHSIZE;BEGIN{13}REWRITE
(POOL,'','/O');IF NOT EOF(POOL)THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! Couldn''t open the pool file.');QUIT;END;{30}NAMEPTR:=1;STRINGPTR:=
128;BYTEPTR:=1;BYTESTART[0]:=1;BYTESTART[1]:=1;{33}TOKPTR:=1;TEXTPTR:=1;
TOKSTART[0]:=1;TOKSTART[1]:=1;{35}ILK[0]:=0;EQUIV[0]:=0;{39}FOR H:=0 TO
HASHSIZE-1 DO BEGIN HASH[H]:=0;CHOPHASH[H]:=0;END;{58}LASTUNNAMED:=0;
TEXTLINK[0]:=0;{123}MODULE[0]:=32;{149}DEBUG TROUBLESHOOT:=TRUE;DDT:=
9999;GUBED END;{10}FUNCTION OPENINPUT:BOOLEAN;BEGIN RESET(INPUT,'',
'/E/I/O');OPENINPUT:=EOF(INPUT);END;{15}FUNCTION INPUTLN:BOOLEAN;BEGIN
READLN;IF EOF(INPUT)THEN INPUTLN:=FALSE ELSE BEGIN LIMIT:=0;BUFFER[0]:=
ORD(INPUT↑);IF BUFFER[0]<>12 THEN WHILE BUFFER[LIMIT]<>13 DO IF LIMIT=
BUFSIZE-1 THEN BEGIN BUFFER[LIMIT]:=13;WRITELN(TTY);WRITE(TTY,
'! Input line too long');ERROR;END ELSE BEGIN LIMIT:=LIMIT+1;GET(INPUT);
IF EOF(INPUT)THEN BUFFER[LIMIT]:=13 ELSE BUFFER[LIMIT]:=ORD(INPUT↑);END;
INPUTLN:=TRUE;END;END;{36}PROCEDURE PRINTID(P:NAMEPOINTER);VAR K:0..
MAXBYTES;BEGIN IF P>=NAMEPTR THEN WRITE(TTY,'IMPOSSIBLE')ELSE FOR K:=
BYTESTART[P]TO BYTESTART[P+1]-1 DO WRITE(TTY,CHR(BYTEMEM[K]));END;{40}
FUNCTION IDLOOKUP(T:EIGHTBITS):NAMEPOINTER;LABEL 31,32;VAR C:EIGHTBITS;I
:0..BUFSIZE;H:0..HASHSIZE;K:0..MAXBYTES;L:0..BUFSIZE;P,Q:NAMEPOINTER;S:0
..UNAMBIGLENGT;BEGIN L:=IDLOC-IDFIRST;{41}H:=BUFFER[IDFIRST];I:=IDFIRST
+1;WHILE I<IDLOC DO BEGIN H:=(H+H+BUFFER[I])MOD HASHSIZE;I:=I+1;END;{42}
P:=HASH[H];WHILE P<>0 DO BEGIN IF BYTESTART[P+1]-BYTESTART[P]=L THEN{43}
BEGIN I:=IDFIRST;K:=BYTESTART[P];WHILE(I<IDLOC)AND(BUFFER[I]=BYTEMEM[K])
DO BEGIN I:=I+1;K:=K+1;END;IF I=IDLOC THEN GOTO 31;END;P:=LINK[P];END;P
:=NAMEPTR;LINK[P]:=HASH[H];HASH[H]:=P;31:;IF(P=NAMEPTR)OR(T<>0)THEN{44}
BEGIN IF((P<>NAMEPTR)AND(T<>0)AND(ILK[P]=0))OR((P=NAMEPTR)AND(T=0)AND(
BUFFER[IDFIRST]<>34))THEN{45}BEGIN I:=IDFIRST;S:=0;H:=0;WHILE(I<IDLOC)
AND(S<UNAMBIGLENGT)DO BEGIN IF BUFFER[I]<>24 THEN BEGIN IF BUFFER[I]>=97
THEN CHOPPEDID[S]:=BUFFER[I]-32 ELSE CHOPPEDID[S]:=BUFFER[I];H:=(H+H+
CHOPPEDID[S])MOD HASHSIZE;S:=S+1;END;I:=I+1;END;CHOPPEDID[S]:=0;END;IF P
<>NAMEPTR THEN{46}BEGIN IF ILK[P]=0 THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! This identifier has already appeared');ERROR;{47}Q:=CHOPHASH[H];IF Q=
P THEN CHOPHASH[H]:=EQUIV[P]ELSE BEGIN WHILE EQUIV[Q]<>P DO Q:=EQUIV[Q];
EQUIV[Q]:=EQUIV[P];END;END ELSE BEGIN WRITELN(TTY);WRITE(TTY,
'! This identifier was defined before');ERROR;END;ILK[P]:=T;END ELSE{48}
BEGIN IF(T=0)AND(BUFFER[IDFIRST]<>34)THEN{49}BEGIN Q:=CHOPHASH[H];WHILE
Q<>0 DO BEGIN{50}BEGIN K:=BYTESTART[Q];S:=0;WHILE(K<BYTESTART[Q+1])AND(S
<UNAMBIGLENGT)DO BEGIN C:=BYTEMEM[K];IF C<>24 THEN BEGIN IF C>=97 THEN C
:=C-32;IF CHOPPEDID[S]<>C THEN GOTO 32;S:=S+1;END;K:=K+1;END;IF(K=
BYTESTART[Q+1])AND(CHOPPEDID[S]<>0)THEN GOTO 32;WRITELN(TTY);WRITE(TTY,
'! Identifier conflict with ');FOR K:=BYTESTART[Q]TO BYTESTART[Q+1]-1 DO
WRITE(TTY,CHR(BYTEMEM[K]));ERROR;Q:=0;32:END;Q:=EQUIV[Q];END;EQUIV[P]:=
CHOPHASH[H];CHOPHASH[H]:=P;END;IF BYTEPTR+L>MAXBYTES THEN BEGIN WRITELN(
TTY);WRITE(TTY,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
QUIT;END;IF NAMEPTR=MAXNAMES THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! Sorry, ','name',' capacity exceeded');ERROR;QUIT;END;I:=IDFIRST;K:=
BYTEPTR;WHILE I<IDLOC DO BEGIN BYTEMEM[K]:=BUFFER[I];K:=K+1;I:=I+1;END;
BYTEPTR:=K;NAMEPTR:=NAMEPTR+1;BYTESTART[NAMEPTR]:=K;IF BUFFER[IDFIRST]<>
34 THEN ILK[P]:=T ELSE{51}BEGIN ILK[P]:=1;IF L-DOUBLECHARS=2 THEN EQUIV[
P]:=BUFFER[IDFIRST+1]+32768 ELSE BEGIN EQUIV[P]:=STRINGPTR+32768;
STRINGPTR:=STRINGPTR+1;WRITE(POOL,CHR(31+L-DOUBLECHARS));I:=IDFIRST+1;
WHILE I<IDLOC DO BEGIN WRITE(POOL,CHR(BUFFER[I]));IF(BUFFER[I]=34)OR(
BUFFER[I]=64)THEN I:=I+2 ELSE I:=I+1;END;END;END;END;END;IDLOOKUP:=P;END
;{53}FUNCTION MODLOOKUP(L:SIXTEENBITS):NAMEPOINTER;LABEL 31;VAR C:(LESS,
EQUAL,GREATER,PREFIX,EXTENSION);J:0..LONGESTNAME;K:0..MAXBYTES;P:
NAMEPOINTER;Q:NAMEPOINTER;BEGIN C:=GREATER;Q:=0;P:=ILK[0];WHILE P<>0 DO
BEGIN{55}K:=BYTESTART[P];C:=EQUAL;J:=1;WHILE(K<BYTESTART[P+1])AND(J<=L)
AND(MODULE[J]=BYTEMEM[K])DO BEGIN K:=K+1;J:=J+1;END;IF K=BYTESTART[P+1]
THEN IF J>L THEN C:=EQUAL ELSE C:=EXTENSION ELSE IF J>L THEN C:=PREFIX
ELSE IF MODULE[J]<BYTEMEM[K]THEN C:=LESS ELSE C:=GREATER;Q:=P;IF C=LESS
THEN P:=LINK[Q]ELSE IF C=GREATER THEN P:=ILK[Q]ELSE GOTO 31;END;{54}IF
BYTEPTR+L>MAXBYTES THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ',
'byte memory',' capacity exceeded');ERROR;QUIT;END;IF NAMEPTR=MAXNAMES
THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ','name',
' capacity exceeded');ERROR;QUIT;END;P:=NAMEPTR;IF C=LESS THEN LINK[Q]:=
P ELSE ILK[Q]:=P;LINK[P]:=0;ILK[P]:=0;C:=EQUAL;FOR J:=1 TO L DO BYTEMEM[
BYTEPTR+J-1]:=MODULE[J];BYTEPTR:=BYTEPTR+L;NAMEPTR:=NAMEPTR+1;BYTESTART[
NAMEPTR]:=BYTEPTR;31:IF C<>EQUAL THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! Incompatible module names');ERROR;P:=0;END;MODLOOKUP:=P;END;{56}
FUNCTION PREFIXLOOKUP(L:SIXTEENBITS):NAMEPOINTER;LABEL 31;VAR C:(LESS,
EQUAL,GREATER,PREFIX,EXTENSION);COUNT:0..MAXNAMES;J:0..LONGESTNAME;K:0..
MAXBYTES;P:NAMEPOINTER;Q:NAMEPOINTER;R:NAMEPOINTER;BEGIN Q:=0;P:=ILK[0];
COUNT:=0;R:=0;WHILE P<>0 DO BEGIN{55}K:=BYTESTART[P];C:=EQUAL;J:=1;WHILE
(K<BYTESTART[P+1])AND(J<=L)AND(MODULE[J]=BYTEMEM[K])DO BEGIN K:=K+1;J:=J
+1;END;IF K=BYTESTART[P+1]THEN IF J>L THEN C:=EQUAL ELSE C:=EXTENSION
ELSE IF J>L THEN C:=PREFIX ELSE IF MODULE[J]<BYTEMEM[K]THEN C:=LESS ELSE
C:=GREATER;IF C=LESS THEN P:=LINK[P]ELSE IF C=GREATER THEN P:=ILK[P]ELSE
BEGIN R:=P;COUNT:=COUNT+1;Q:=ILK[P];P:=LINK[P];END;IF P=0 THEN BEGIN P:=
Q;Q:=0;END;END;IF COUNT<>1 THEN IF COUNT=0 THEN BEGIN WRITELN(TTY);WRITE
(TTY,'! Name does not match');ERROR;END ELSE BEGIN WRITELN(TTY);WRITE(
TTY,'! Ambiguous prefix');ERROR;END;PREFIXLOOKUP:=R;END;{60}PROCEDURE
STORETWOBYTE(X:SIXTEENBITS);BEGIN IF TOKPTR+2>MAXTOKS THEN BEGIN WRITELN
(TTY);WRITE(TTY,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END
;TOKMEM[TOKPTR]:=X DIV 256;TOKMEM[TOKPTR+1]:=X MOD 256;TOKPTR:=TOKPTR+2;
END;{61}DEBUG PROCEDURE PRINTREPL(P:TEXTPOINTER);VAR K:0..MAXTOKS;A:
SIXTEENBITS;BEGIN IF P>=TEXTPTR THEN WRITE(TTY,'BAD')ELSE BEGIN K:=
TOKSTART[P];WHILE K<TOKSTART[P+1]DO BEGIN A:=TOKMEM[K];IF A>=128 THEN{62
}BEGIN K:=K+1;IF A<168 THEN BEGIN A:=(A-128)*256+TOKMEM[K];PRINTID(A);IF
BYTEMEM[BYTESTART[A]]=34 THEN WRITE(TTY,'"')ELSE WRITE(TTY,' ');END ELSE
IF A<208 THEN BEGIN WRITE(TTY,'@<');PRINTID((A-168)*256+TOKMEM[K]);WRITE
(TTY,'@>');END ELSE BEGIN A:=(A-208)*256+TOKMEM[K];WRITE(TTY,'@{',A:0,
'@',CHR(126));END;END ELSE{63}CASE A OF 9:WRITE(TTY,'@{');10:WRITE(TTY,
'@',CHR(126));12:WRITE(TTY,'@''');13:WRITE(TTY,'#');64:WRITE(TTY,'@@');
OTHERS:WRITE(TTY,CHR(A))END;K:=K+1;END;END;END;GUBED{70}PROCEDURE
PUSHLEVEL(P:NAMEPOINTER);BEGIN IF STACKPTR=STACKSIZE THEN BEGIN WRITELN(
TTY);WRITE(TTY,'! Sorry, ','stack',' capacity exceeded');ERROR;QUIT;END
ELSE BEGIN STACK[STACKPTR]:=CURSTATE;STACKPTR:=STACKPTR+1;CURSTATE.
NAMEFIELD:=P;CURSTATE.REPLFIELD:=EQUIV[P];CURSTATE.BYTEFIELD:=TOKSTART[
CURSTATE.REPLFIELD];CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+1];
END;END;{71}PROCEDURE POPLEVEL;LABEL 10;BEGIN IF TEXTLINK[CURSTATE.
REPLFIELD]=0 THEN BEGIN IF ILK[CURSTATE.NAMEFIELD]=3 THEN{77}BEGIN STAT
IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;TATS NAMEPTR:=NAMEPTR-1;
TEXTPTR:=TEXTPTR-1;TOKPTR:=TOKSTART[TEXTPTR];DEBUG BYTEPTR:=BYTEPTR-1;
GUBED END;END ELSE IF TEXTLINK[CURSTATE.REPLFIELD]<MAXTEXTS THEN BEGIN
CURSTATE.REPLFIELD:=TEXTLINK[CURSTATE.REPLFIELD];CURSTATE.BYTEFIELD:=
TOKSTART[CURSTATE.REPLFIELD];CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.
REPLFIELD+1];GOTO 10;END;STACKPTR:=STACKPTR-1;IF STACKPTR>0 THEN
CURSTATE:=STACK[STACKPTR];10:END;{73}FUNCTION GETOUTPUT:SIXTEENBITS;
LABEL 20,30;VAR A:SIXTEENBITS;B:EIGHTBITS;BAL:SIXTEENBITS;BEGIN 20:IF
STACKPTR=0 THEN A:=0 ELSE BEGIN IF CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD
THEN BEGIN POPLEVEL;GOTO 20;END;A:=TOKMEM[CURSTATE.BYTEFIELD];CURSTATE.
BYTEFIELD:=CURSTATE.BYTEFIELD+1;IF A<128 THEN BEGIN IF A=13 THEN{78}
BEGIN PUSHLEVEL(NAMEPTR-1);GOTO 20;END;END ELSE BEGIN A:=(A-128)*256+
TOKMEM[CURSTATE.BYTEFIELD];CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;IF A
<10240 THEN{75}BEGIN CASE ILK[A]OF 0:BEGIN CURVAL:=A;A:=130;END;1:BEGIN
CURVAL:=EQUIV[A]-32768;A:=128;END;2:BEGIN PUSHLEVEL(A);GOTO 20;END;3:
BEGIN{76}WHILE(CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD)AND(STACKPTR>0)DO
POPLEVEL;IF(STACKPTR=0)OR(TOKMEM[CURSTATE.BYTEFIELD]<>40)THEN BEGIN
WRITELN(TTY);WRITE(TTY,'! No parameter given for ');PRINTID(A);ERROR;
GOTO 20;END{79}BAL:=1;CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;WHILE
TRUE DO BEGIN B:=TOKMEM[CURSTATE.BYTEFIELD];CURSTATE.BYTEFIELD:=CURSTATE
.BYTEFIELD+1;IF B=13 THEN STORETWOBYTE(NAMEPTR+32767)ELSE BEGIN IF B>=
128 THEN BEGIN IF TOKPTR=MAXTOKS THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;TOKMEM[TOKPTR]
:=B;TOKPTR:=TOKPTR+1;B:=TOKMEM[CURSTATE.BYTEFIELD];CURSTATE.BYTEFIELD:=
CURSTATE.BYTEFIELD+1;END ELSE CASE B OF 40:BAL:=BAL+1;41:BEGIN BAL:=BAL
-1;IF BAL=0 THEN GOTO 30;END;39:REPEAT IF TOKPTR=MAXTOKS THEN BEGIN
WRITELN(TTY);WRITE(TTY,'! Sorry, ','token',' capacity exceeded');ERROR;
QUIT;END;TOKMEM[TOKPTR]:=B;TOKPTR:=TOKPTR+1;B:=TOKMEM[CURSTATE.BYTEFIELD
];CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;UNTIL B=39;OTHERS:END;IF
TOKPTR=MAXTOKS THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ','token',
' capacity exceeded');ERROR;QUIT;END;TOKMEM[TOKPTR]:=B;TOKPTR:=TOKPTR+1;
END;END;30:;EQUIV[NAMEPTR]:=TEXTPTR;ILK[NAMEPTR]:=2;DEBUG IF BYTEPTR=
MAXBYTES THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ','byte memory',
' capacity exceeded');ERROR;QUIT;END;BYTEMEM[BYTEPTR]:=35;BYTEPTR:=
BYTEPTR+1;GUBED IF NAMEPTR=MAXNAMES THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! Sorry, ','name',' capacity exceeded');ERROR;QUIT;END;NAMEPTR:=NAMEPTR
+1;BYTESTART[NAMEPTR]:=BYTEPTR;IF TEXTPTR=MAXTEXTS THEN BEGIN WRITELN(
TTY);WRITE(TTY,'! Sorry, ','text',' capacity exceeded');ERROR;QUIT;END;
TEXTLINK[TEXTPTR]:=0;TEXTPTR:=TEXTPTR+1;TOKSTART[TEXTPTR]:=TOKPTR;
PUSHLEVEL(A);GOTO 20;END;OTHERS:BEGIN WRITELN(TTY);WRITE(TTY,
'! This can''t happen (','output',')');ERROR;QUIT;END END END ELSE IF A<
20480 THEN{74}BEGIN A:=A-10240;IF EQUIV[A]<>0 THEN PUSHLEVEL(A)ELSE IF A
<>0 THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Not present: <');PRINTID(A);
WRITE(TTY,'>');ERROR;END;GOTO 20;END ELSE BEGIN CURVAL:=A-20480;A:=129;
END;END;END;DEBUG IF TROUBLESHOOT THEN DEBUGHELP;GUBED GETOUTPUT:=A;END;
{83}PROCEDURE FLUSHBUFFER;VAR K:0..OUTBUFSIZE;BEGIN FOR K:=1 TO BREAKPTR
DO WRITE(CHR(OUTBUF[K-1]));WRITELN;LINE:=LINE+1;IF LINE MOD 100=0 THEN
WRITE(TTY,'.');IF BREAKPTR<OUTPTR THEN BEGIN IF OUTBUF[BREAKPTR]=32 THEN
BREAKPTR:=BREAKPTR+1;FOR K:=BREAKPTR TO OUTPTR-1 DO OUTBUF[K-BREAKPTR]:=
OUTBUF[K];END;OUTPTR:=OUTPTR-BREAKPTR;BREAKPTR:=0;IF OUTPTR>LINELENGTH
THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Long line must be truncated');ERROR
;OUTPTR:=LINELENGTH;END;END;{85}PROCEDURE APPVAL(V:INTEGER);VAR K:0..
OUTBUFSIZE;BEGIN K:=OUTBUFSIZE;REPEAT OUTBUF[K]:=V MOD 10;V:=V DIV 10;K
:=K-1;UNTIL V=0;REPEAT K:=K+1;OUTBUF[OUTPTR]:=OUTBUF[K]+48;OUTPTR:=
OUTPTR+1;UNTIL K=OUTBUFSIZE;END;{87}PROCEDURE SENDOUT(T:EIGHTBITS;V:
SIXTEENBITS);LABEL 20;VAR K:0..LINELENGTH;BEGIN{88}20:CASE OUTSTATE OF 1
:IF T<>3 THEN BEGIN BREAKPTR:=OUTPTR;IF T=2 THEN BEGIN OUTBUF[OUTPTR]:=
32;OUTPTR:=OUTPTR+1;END;END;2:BEGIN OUTBUF[OUTPTR]:=44-OUTAPP;OUTPTR:=
OUTPTR+1;IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;BREAKPTR:=OUTPTR;END;3,4:
BEGIN{89}IF OUTVAL<0 THEN BEGIN OUTBUF[OUTPTR]:=45;OUTPTR:=OUTPTR+1;END
ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;OUTPTR:=OUTPTR+1;
END;APPVAL(ABS(OUTVAL));IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;;OUTSTATE
:=OUTSTATE-2;GOTO 20;END;5:{90}BEGIN IF(T=3)OR({91}((T=2)AND(V=3)AND(((
OUTCONTRIB[1]=68)AND(OUTCONTRIB[2]=73)AND(OUTCONTRIB[3]=86))OR((
OUTCONTRIB[1]=77)AND(OUTCONTRIB[2]=79)AND(OUTCONTRIB[3]=68))))OR((T=0)
AND((V=42)OR(V=47))))THEN BEGIN{89}IF OUTVAL<0 THEN BEGIN OUTBUF[OUTPTR]
:=45;OUTPTR:=OUTPTR+1;END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=
OUTSIGN;OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));IF OUTPTR>LINELENGTH
THEN FLUSHBUFFER;;OUTSIGN:=43;OUTVAL:=OUTAPP;END ELSE OUTVAL:=OUTVAL+
OUTAPP;OUTSTATE:=3;GOTO 20;END;0:IF T<>3 THEN BREAKPTR:=OUTPTR;OTHERS:
END;IF T<>0 THEN FOR K:=1 TO V DO BEGIN OUTBUF[OUTPTR]:=OUTCONTRIB[K];
OUTPTR:=OUTPTR+1;END ELSE BEGIN OUTBUF[OUTPTR]:=V;OUTPTR:=OUTPTR+1;END;
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;IF T>=2 THEN OUTSTATE:=1 ELSE
OUTSTATE:=0 END;{92}PROCEDURE SENDSIGN(V:INTEGER);BEGIN CASE OUTSTATE OF
2,4:OUTAPP:=OUTAPP*V;3:BEGIN OUTAPP:=V;OUTSTATE:=4;END;5:BEGIN OUTVAL:=
OUTVAL+OUTAPP;OUTAPP:=V;OUTSTATE:=4;END;OTHERS:BEGIN BREAKPTR:=OUTPTR;
OUTAPP:=V;OUTSTATE:=2;END END;END;{93}PROCEDURE SENDVAL(V:INTEGER);LABEL
666,10;BEGIN CASE OUTSTATE OF 1:BEGIN{96}IF(OUTPTR=BREAKPTR+3)OR((OUTPTR
=BREAKPTR+4)AND(OUTBUF[BREAKPTR]=32))THEN IF((OUTBUF[OUTPTR-3]=68)AND(
OUTBUF[OUTPTR-2]=73)AND(OUTBUF[OUTPTR-1]=86))OR((OUTBUF[OUTPTR-3]=77)AND
(OUTBUF[OUTPTR-2]=79)AND(OUTBUF[OUTPTR-1]=68))THEN GOTO 666;OUTSIGN:=32;
OUTSTATE:=3;OUTVAL:=V;BREAKPTR:=OUTPTR;END;0:BEGIN{95}IF(OUTPTR=BREAKPTR
+1)AND((OUTBUF[BREAKPTR]=42)OR(OUTBUF[BREAKPTR]=47))THEN GOTO 666;
OUTSIGN:=0;OUTSTATE:=3;OUTVAL:=V;BREAKPTR:=OUTPTR;END;{94}2:BEGIN
OUTSIGN:=43;OUTSTATE:=3;OUTVAL:=OUTAPP*V;END;3:BEGIN OUTSTATE:=5;OUTAPP
:=V;END;4:BEGIN OUTSTATE:=5;OUTAPP:=OUTAPP*V;END;5:BEGIN OUTVAL:=OUTVAL+
OUTAPP;OUTAPP:=V;END;OTHERS:GOTO 666 END;GOTO 10;666:{97}IF V>=0 THEN
BEGIN IF OUTSTATE=1 THEN BEGIN BREAKPTR:=OUTPTR;OUTBUF[OUTPTR]:=32;
OUTPTR:=OUTPTR+1;END;APPVAL(V);IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;
OUTSTATE:=1;END ELSE BEGIN OUTBUF[OUTPTR]:=40;OUTPTR:=OUTPTR+1;OUTBUF[
OUTPTR]:=45;OUTPTR:=OUTPTR+1;APPVAL(-V);OUTBUF[OUTPTR]:=41;OUTPTR:=
OUTPTR+1;IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=0;END;10:END;{
99}PROCEDURE SENDTHEOUTPU;LABEL 2,21,22;VAR CURCHAR:EIGHTBITS;K:0..
LINELENGTH;J:0..MAXBYTES;N:INTEGER;BEGIN WHILE STACKPTR>0 DO BEGIN
CURCHAR:=GETOUTPUT;21:CASE CURCHAR OF 0:;{102}65,66,67,68,69,70,71,72,73
,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90:BEGIN OUTCONTRIB[1]
:=CURCHAR;SENDOUT(2,1);END;97,98,99,100,101,102,103,104,105,106,107,108,
109,110,111,112,113,114,115,116,117,118,119,120,121,122:BEGIN OUTCONTRIB
[1]:=CURCHAR-32;SENDOUT(2,1);END;130:BEGIN K:=0;J:=BYTESTART[CURVAL];
WHILE(K<MAXIDLENGTH)AND(J<BYTESTART[CURVAL+1])DO BEGIN K:=K+1;OUTCONTRIB
[K]:=BYTEMEM[J];J:=J+1;IF OUTCONTRIB[K]>=97 THEN OUTCONTRIB[K]:=
OUTCONTRIB[K]-32 ELSE IF OUTCONTRIB[K]=24 THEN K:=K-1;END;SENDOUT(2,K);
END;{104}48,49,50,51,52,53,54,55,56,57:BEGIN N:=0;REPEAT N:=10*N+CURCHAR
-48;CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>57)OR(CURCHAR<48);SENDVAL(N);K:=0;
IF CURCHAR=101 THEN CURCHAR:=69;IF CURCHAR=69 THEN GOTO 2 ELSE GOTO 21;
END;12:BEGIN N:=0;CURCHAR:=48;REPEAT N:=8*N+CURCHAR-48;CURCHAR:=
GETOUTPUT;UNTIL(CURCHAR>55)OR(CURCHAR<48);SENDVAL(N);GOTO 21;END;128:
SENDVAL(CURVAL);46:BEGIN K:=1;OUTCONTRIB[1]:=46;CURCHAR:=GETOUTPUT;IF
CURCHAR=46 THEN BEGIN OUTCONTRIB[2]:=46;SENDOUT(1,2);END ELSE IF(CURCHAR
>=48)AND(CURCHAR<=57)THEN GOTO 2 ELSE BEGIN SENDOUT(0,46);GOTO 21;END;
END;43,45:SENDSIGN(44-CURCHAR);{100}4:BEGIN OUTCONTRIB[1]:=65;OUTCONTRIB
[2]:=78;OUTCONTRIB[3]:=68;SENDOUT(2,3);END;5:BEGIN OUTCONTRIB[1]:=78;
OUTCONTRIB[2]:=79;OUTCONTRIB[3]:=84;SENDOUT(2,3);END;6:BEGIN OUTCONTRIB[
1]:=73;OUTCONTRIB[2]:=78;SENDOUT(2,2);END;31:BEGIN OUTCONTRIB[1]:=79;
OUTCONTRIB[2]:=82;SENDOUT(2,2);END;95:BEGIN OUTCONTRIB[1]:=58;OUTCONTRIB
[2]:=61;SENDOUT(1,2);END;27:BEGIN OUTCONTRIB[1]:=60;OUTCONTRIB[2]:=62;
SENDOUT(1,2);END;28:BEGIN OUTCONTRIB[1]:=60;OUTCONTRIB[2]:=61;SENDOUT(1,
2);END;29:BEGIN OUTCONTRIB[1]:=62;OUTCONTRIB[2]:=61;SENDOUT(1,2);END;30:
BEGIN OUTCONTRIB[1]:=61;OUTCONTRIB[2]:=61;SENDOUT(1,2);END;32:BEGIN
OUTCONTRIB[1]:=46;OUTCONTRIB[2]:=46;SENDOUT(1,2);END;39:{103}BEGIN K:=1;
OUTCONTRIB[1]:=39;REPEAT IF K<LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=
GETOUTPUT;UNTIL(OUTCONTRIB[K]=39)OR(STACKPTR=0);IF K=LINELENGTH THEN
BEGIN WRITELN(TTY);WRITE(TTY,'! String too long');ERROR;END;SENDOUT(1,K)
;CURCHAR:=GETOUTPUT;IF CURCHAR=39 THEN OUTSTATE:=6;GOTO 21;END;{101}33,
34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,24,96,123
,124,126:SENDOUT(0,CURCHAR);{106}9:BEGIN IF BRACELEVEL=0 THEN SENDOUT(0,
123)ELSE SENDOUT(0,91);BRACELEVEL:=BRACELEVEL+1;END;10:IF BRACELEVEL>0
THEN BEGIN BRACELEVEL:=BRACELEVEL-1;IF BRACELEVEL=0 THEN SENDOUT(0,126)
ELSE SENDOUT(0,93);END ELSE BEGIN WRITELN(TTY);WRITE(TTY,'! Extra @}');
ERROR;END;129:IF BRACELEVEL=0 THEN BEGIN SENDOUT(0,123);SENDVAL(CURVAL);
SENDOUT(0,126);END ELSE BEGIN SENDOUT(0,91);SENDVAL(CURVAL);SENDOUT(0,93
);END;127:BEGIN SENDOUT(3,0);OUTSTATE:=6;END;OTHERS:BEGIN WRITELN(TTY);
WRITE(TTY,'! Can''t output ascii code ',CURCHAR:0);ERROR;END END;GOTO 22
;2:{105}REPEAT IF K<LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=CURCHAR;
CURCHAR:=GETOUTPUT;IF(OUTCONTRIB[K]=69)AND((CURCHAR=43)OR(CURCHAR=45))
THEN BEGIN IF K<LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=CURCHAR;CURCHAR:=
GETOUTPUT;END ELSE IF CURCHAR=101 THEN CURCHAR:=69;UNTIL(CURCHAR<>69)AND
((CURCHAR<48)OR(CURCHAR>57));IF K=LINELENGTH THEN BEGIN WRITELN(TTY);
WRITE(TTY,'! Fraction too long');ERROR;END;SENDOUT(3,K);GOTO 21;22:END;
END;{110}PROCEDURE GETLINE;BEGIN IF BUFFER[0]=12 THEN LINE:=0;IF INPUTLN
THEN BEGIN IF LINE=0 THEN BEGIN PAGE:=PAGE+1;WRITE(TTY,PAGE:0,' ');{111}
STANFORD IF(PAGE=1)AND(LIMIT=29)THEN IF(BUFFER[0]=67)AND(BUFFER[8]=22)
THEN REPEAT IF INPUTLN THEN ELSE BEGIN LIMIT:=0;BUFFER[0]:=12;END;UNTIL
BUFFER[0]=12 DROFNATS;END;IF BUFFER[LIMIT]=13 THEN BUFFER[LIMIT]:=32;END
ELSE IF BUFFER[0]<>12 THEN BEGIN LIMIT:=0;BUFFER[0]:=12;END ELSE
INPUTHASENDE:=TRUE;LINE:=LINE+1;LOC:=0;END;{112}FUNCTION CONTROLCODE(C:
ASCIICODE):EIGHTBITS;BEGIN CASE C OF 64:CONTROLCODE:=64;39:CONTROLCODE:=
12;32,9,42:CONTROLCODE:=137;84,116:CONTROLCODE:=131;68,100:CONTROLCODE:=
133;70,102:CONTROLCODE:=132;123:CONTROLCODE:=9;126:CONTROLCODE:=10;80,
112:CONTROLCODE:=134;38:CONTROLCODE:=127;60:CONTROLCODE:=135;OTHERS:
CONTROLCODE:=0 END;END;{113}FUNCTION SKIPAHEAD:EIGHTBITS;LABEL 30;VAR C:
EIGHTBITS;BEGIN WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;IF
BUFFER[0]=12 THEN BEGIN LOC:=1;C:=136;GOTO 30;END;END;BUFFER[LIMIT+1]:=
64;WHILE BUFFER[LOC]<>64 DO LOC:=LOC+1;IF LOC<=LIMIT THEN BEGIN LOC:=LOC
+2;C:=CONTROLCODE(BUFFER[LOC-1]);IF(C<>0)OR(BUFFER[LOC-1]=62)THEN GOTO
30;END;END;30:SKIPAHEAD:=C;END;{114}PROCEDURE SKIPCOMMENT;LABEL 10;VAR
BAL:EIGHTBITS;C:ASCIICODE;BEGIN BAL:=0;WHILE TRUE DO BEGIN IF LOC>LIMIT
THEN BEGIN GETLINE;IF BUFFER[0]=12 THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! Page ended in mid-comment');ERROR;LOC:=1;GOTO 10;END;END;C:=BUFFER[
LOC];LOC:=LOC+1;{115}IF C=64 THEN BEGIN C:=BUFFER[LOC];IF(C<>32)AND(C<>9
)AND(C<>42)THEN LOC:=LOC+1 ELSE BEGIN WRITELN(TTY);WRITE(TTY,
'! Module ended in mid-comment');ERROR;LOC:=LOC-1;GOTO 10;END END ELSE
IF(C=92)AND(BUFFER[LOC]<>64)THEN LOC:=LOC+1 ELSE IF C=123 THEN BAL:=BAL
+1 ELSE IF C=126 THEN BEGIN IF BAL=0 THEN GOTO 10;BAL:=BAL-1;END;END;10:
END;{117}FUNCTION GETNEXT:EIGHTBITS;LABEL 20,30;VAR C:EIGHTBITS;D:
EIGHTBITS;J,K:0..LONGESTNAME;BEGIN 20:IF LOC>LIMIT THEN GETLINE;C:=
BUFFER[LOC];LOC:=LOC+1;CASE C OF 65,66,67,68,69,70,71,72,73,74,75,76,77,
78,79,80,81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,102,103,104,105,
106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122:{119
}BEGIN LOC:=LOC-1;IDFIRST:=LOC;REPEAT LOC:=LOC+1;D:=BUFFER[LOC];UNTIL((D
<48)OR((D>57)AND(D<65))OR((D>90)AND(D<97))OR(D>122))AND(D<>24);IF LOC>
IDFIRST+1 THEN BEGIN C:=130;IDLOC:=LOC;END;END;34:{120}BEGIN DOUBLECHARS
:=0;IDFIRST:=LOC-1;REPEAT D:=BUFFER[LOC];LOC:=LOC+1;IF(D=34)OR(D=64)THEN
IF BUFFER[LOC]=D THEN BEGIN LOC:=LOC+1;D:=0;DOUBLECHARS:=DOUBLECHARS+1;
END ELSE IF D=64 THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! Double @ sign missing');ERROR;END ELSE IF LOC>LIMIT THEN BEGIN
WRITELN(TTY);WRITE(TTY,'! String constant didn''t end');ERROR;D:=34;END;
UNTIL D=34;IDLOC:=LOC-1;C:=130;END;64:{121}BEGIN C:=CONTROLCODE(BUFFER[
LOC]);LOC:=LOC+1;IF C=0 THEN GOTO 20 ELSE IF C=135 THEN{122}BEGIN{124}K
:=0;WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;IF BUFFER[0]=12
THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Page ended in module name');ERROR;
LOC:=1;GOTO 30;END;END;D:=BUFFER[LOC];{125}IF D=64 THEN BEGIN D:=BUFFER[
LOC+1];IF D=62 THEN BEGIN LOC:=LOC+2;GOTO 30;END;IF(D=32)OR(D=9)OR(D=42)
THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Module name didn''t end');ERROR;
GOTO 30;END;K:=K+1;MODULE[K]:=64;LOC:=LOC+1;END;LOC:=LOC+1;IF K<
LONGESTNAME-1 THEN K:=K+1;IF(D=32)OR(D=9)THEN BEGIN D:=32;IF MODULE[K-1]
=32 THEN K:=K-1;END;MODULE[K]:=D;END;30:{126}IF K>=LONGESTNAME-2 THEN
BEGIN WRITELN(TTY);WRITE(TTY,'! Module name too long: ');FOR J:=1 TO 25
DO WRITE(TTY,CHR(MODULE[J]));WRITE(TTY,'...');END;IF(MODULE[K]=32)AND(K>
0)THEN K:=K-1;IF K>3 THEN BEGIN IF(MODULE[K]=46)AND(MODULE[K-1]=46)AND(
MODULE[K-2]=46)THEN CURMODULE:=PREFIXLOOKUP(K-3)ELSE CURMODULE:=
MODLOOKUP(K);END ELSE CURMODULE:=MODLOOKUP(K);END ELSE IF C=131 THEN
BEGIN REPEAT C:=SKIPAHEAD;UNTIL C<>64;IF BUFFER[LOC-1]<>62 THEN BEGIN
WRITELN(TTY);WRITE(TTY,'! Improper @ within @t...@>');ERROR;END;GOTO 20;
END;END;{118}46:IF BUFFER[LOC]=46 THEN BEGIN C:=32;LOC:=LOC+1;END;58:IF
BUFFER[LOC]=61 THEN BEGIN C:=95;LOC:=LOC+1;END;61:IF BUFFER[LOC]=61 THEN
BEGIN C:=30;LOC:=LOC+1;END;62:IF BUFFER[LOC]=61 THEN BEGIN C:=29;LOC:=
LOC+1;END;60:IF BUFFER[LOC]=61 THEN BEGIN C:=28;LOC:=LOC+1;END ELSE IF
BUFFER[LOC]=62 THEN BEGIN C:=27;LOC:=LOC+1;END;40:IF BUFFER[LOC]=42 THEN
BEGIN C:=9;LOC:=LOC+1;END;42:IF BUFFER[LOC]=41 THEN BEGIN C:=10;LOC:=LOC
+1;END;32,9:GOTO 20;123:BEGIN SKIPCOMMENT;GOTO 20;END;12:C:=136;OTHERS:
END;DEBUG IF TROUBLESHOOT THEN DEBUGHELP;GUBED GETNEXT:=C;END;{128}
PROCEDURE SCANNUMERIC(P:NAMEPOINTER);LABEL 21,30;VAR ACCUMULATOR:INTEGER
;NEXTSIGN:-1..+1;Q:NAMEPOINTER;VAL:INTEGER;PROCEDURE ADDIN(V:INTEGER);
BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*V;NEXTSIGN:=+1;END;BEGIN{129}
ACCUMULATOR:=0;NEXTSIGN:=+1;WHILE TRUE DO BEGIN NEXTCONTROL:=GETNEXT;21:
CASE NEXTCONTROL OF 48,49,50,51,52,53,54,55,56,57:BEGIN{131}VAL:=0;
REPEAT VAL:=10*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;UNTIL(NEXTCONTROL
>57)OR(NEXTCONTROL<48);ADDIN(VAL);GOTO 21;END;12:BEGIN{132}VAL:=0;
NEXTCONTROL:=48;REPEAT VAL:=8*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
UNTIL(NEXTCONTROL>55)OR(NEXTCONTROL<48);ADDIN(VAL);GOTO 21;END;130:BEGIN
Q:=IDLOOKUP(0);IF ILK[Q]<>1 THEN BEGIN NEXTCONTROL:=42;GOTO 21;END;ADDIN
(EQUIV[Q]-32768);END;43:;45:NEXTSIGN:=-NEXTSIGN;132,133,135,134,136,137:
GOTO 30;59:BEGIN WRITELN(TTY);WRITE(TTY,
'! Omit semicolon in numeric definition');ERROR;END;OTHERS:{130}BEGIN
WRITELN(TTY);WRITE(TTY,'! Improper numeric definition will be flushed');
ERROR;REPEAT NEXTCONTROL:=SKIPAHEAD UNTIL(NEXTCONTROL>=132);IF
NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;END;
ACCUMULATOR:=0;GOTO 30;END END;END;30:;IF ABS(ACCUMULATOR)>=32768 THEN
BEGIN WRITELN(TTY);WRITE(TTY,'! Value too big: ',ACCUMULATOR:0);ERROR;
ACCUMULATOR:=0;END;EQUIV[P]:=ACCUMULATOR+32768;END;{135}PROCEDURE
SCANREPL(T:EIGHTBITS);LABEL 22,30,31;VAR A:SIXTEENBITS;B:ASCIICODE;BAL:
EIGHTBITS;BEGIN BAL:=0;WHILE TRUE DO BEGIN 22:A:=GETNEXT;CASE A OF 40:
BAL:=BAL+1;41:IF BAL=0 THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Extra )');
ERROR;END ELSE BAL:=BAL-1;39:{138}BEGIN B:=39;WHILE TRUE DO BEGIN IF
TOKPTR=MAXTOKS THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ','token',
' capacity exceeded');ERROR;QUIT;END;TOKMEM[TOKPTR]:=B;TOKPTR:=TOKPTR+1;
IF B=64 THEN IF BUFFER[LOC]=64 THEN LOC:=LOC+1 ELSE BEGIN WRITELN(TTY);
WRITE(TTY,'! You should double @ signs in strings');ERROR;END;IF LOC=
LIMIT THEN BEGIN WRITELN(TTY);WRITE(TTY,'! String didn''t end');ERROR;
BUFFER[LOC]:=39;BUFFER[LOC+1]:=0;END;B:=BUFFER[LOC];LOC:=LOC+1;IF B=39
THEN BEGIN IF BUFFER[LOC]<>39 THEN GOTO 31 ELSE BEGIN LOC:=LOC+1;IF
TOKPTR=MAXTOKS THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ','token',
' capacity exceeded');ERROR;QUIT;END;TOKMEM[TOKPTR]:=39;TOKPTR:=TOKPTR+1
;END;END;END;31:END;35:IF T=3 THEN A:=13;{137}130:BEGIN A:=IDLOOKUP(0);
IF TOKPTR=MAXTOKS THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ','token',
' capacity exceeded');ERROR;QUIT;END;TOKMEM[TOKPTR]:=(A DIV 256)+128;
TOKPTR:=TOKPTR+1;A:=A MOD 256;END;135:IF T<>135 THEN GOTO 30 ELSE BEGIN
IF TOKPTR=MAXTOKS THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ','token',
' capacity exceeded');ERROR;QUIT;END;TOKMEM[TOKPTR]:=(CURMODULE DIV 256)
+168;TOKPTR:=TOKPTR+1;A:=CURMODULE MOD 256;END;133,132,134:IF T<>135
THEN GOTO 30 ELSE BEGIN WRITELN(TTY);WRITE(TTY,'! @',CHR(BUFFER[LOC-1]),
' is ignored in PASCAL text');ERROR;GOTO 22;END;136,137:GOTO 30;OTHERS:
END;IF TOKPTR=MAXTOKS THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ',
'token',' capacity exceeded');ERROR;QUIT;END;TOKMEM[TOKPTR]:=A;TOKPTR:=
TOKPTR+1;END;30:NEXTCONTROL:=A;{136}IF BAL>0 THEN BEGIN WRITELN(TTY);
WRITE(TTY,'! Missing ',BAL:0,' )');ERROR;WHILE BAL>0 DO BEGIN IF TOKPTR=
MAXTOKS THEN BEGIN WRITELN(TTY);WRITE(TTY,'! Sorry, ','token',
' capacity exceeded');ERROR;QUIT;END;TOKMEM[TOKPTR]:=41;TOKPTR:=TOKPTR+1
;BAL:=BAL-1;END;END;IF TEXTPTR=MAXTEXTS THEN BEGIN WRITELN(TTY);WRITE(
TTY,'! Sorry, ','text',' capacity exceeded');ERROR;QUIT;END;CURREPLTEXT
:=TEXTPTR;TEXTPTR:=TEXTPTR+1;TOKSTART[TEXTPTR]:=TOKPTR;END;{139}
PROCEDURE DEFINEMACRO(T:EIGHTBITS);VAR P:NAMEPOINTER;BEGIN P:=IDLOOKUP(T
);SCANREPL(T);EQUIV[P]:=CURREPLTEXT;TEXTLINK[CURREPLTEXT]:=0;END;{141}
PROCEDURE SCANMODULE;LABEL 30,10;VAR P:NAMEPOINTER;BEGIN MODULECOUNT:=
MODULECOUNT+1;{142}NEXTCONTROL:=0;WHILE TRUE DO BEGIN 22:WHILE
NEXTCONTROL<=132 DO BEGIN NEXTCONTROL:=SKIPAHEAD;IF NEXTCONTROL=135 THEN
BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;END;END;IF NEXTCONTROL<>133 THEN
GOTO 30;NEXTCONTROL:=GETNEXT;IF NEXTCONTROL<>130 THEN BEGIN WRITELN(TTY)
;WRITE(TTY,'! Definition flushed, must start with ',
'identifier of length > 1');ERROR;GOTO 22;END;NEXTCONTROL:=GETNEXT;IF
NEXTCONTROL=61 THEN BEGIN SCANNUMERIC(IDLOOKUP(1));GOTO 22;END ELSE IF
NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(2);GOTO 22;END ELSE{143}IF
NEXTCONTROL=40 THEN BEGIN NEXTCONTROL:=GETNEXT;IF NEXTCONTROL=35 THEN
BEGIN NEXTCONTROL:=GETNEXT;IF NEXTCONTROL=41 THEN BEGIN NEXTCONTROL:=
GETNEXT;IF NEXTCONTROL=61 THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! Use == for macros');ERROR;NEXTCONTROL:=30;END;IF NEXTCONTROL=30 THEN
BEGIN DEFINEMACRO(3);GOTO 22;END;END;END;END;WRITELN(TTY);WRITE(TTY,
'! Definition flushed since it starts badly');ERROR;END;30:;{144}CASE
NEXTCONTROL OF 134:P:=0;135:BEGIN P:=CURMODULE;{145}REPEAT NEXTCONTROL:=
GETNEXT;UNTIL NEXTCONTROL<>43;IF(NEXTCONTROL<>61)AND(NEXTCONTROL<>30)
THEN BEGIN WRITELN(TTY);WRITE(TTY,
'! PASCAL text flushed, = sign is missing');ERROR;REPEAT NEXTCONTROL:=
SKIPAHEAD;UNTIL NEXTCONTROL>=136;GOTO 10;END;END;OTHERS:GOTO 10 END;{146
}STORETWOBYTE(53248+MODULECOUNT);SCANREPL(135);{147}IF P=0 THEN BEGIN
TEXTLINK[LASTUNNAMED]:=CURREPLTEXT;LASTUNNAMED:=CURREPLTEXT;END ELSE IF
EQUIV[P]=0 THEN EQUIV[P]:=CURREPLTEXT ELSE BEGIN P:=EQUIV[P];WHILE
TEXTLINK[P]<MAXTEXTS DO P:=TEXTLINK[P];TEXTLINK[P]:=CURREPLTEXT;END;
TEXTLINK[CURREPLTEXT]:=MAXTEXTS;;10:END;{150}DEBUG PROCEDURE DEBUGHELP;
LABEL 888;VAR K:SIXTEENBITS;BEGIN WHILE DDT<>0 DO BEGIN 888:CASE DDT OF
0:;1:PRINTID(DD);2:PRINTREPL(DD);3:BEGIN WRITELN(TTY);WRITE(TTY,'*');
ERROR;END;4:FOR K:=1 TO DD DO WRITE(TTY,CHR(MODULE[K]));5:FOR K:=1 TO DD
DO WRITE(TTY,CHR(OUTCONTRIB[K]));OTHERS:BEGIN WRITE(TTY,'?');READ(TTY,
DDT);END END;END;END;GUBED{151}BEGIN INITIALIZE;{109}IF OPENINPUT THEN
BEGIN WRITELN(TTY);WRITE(TTY,'! Couldn''t open the input file.');QUIT;
END;PAGE:=0;LINE:=0;LIMIT:=0;LOC:=1;BUFFER[0]:=32;INPUTHASENDE:=FALSE;{
152}PHASEONE:=TRUE;MODULECOUNT:=0;REPEAT NEXTCONTROL:=SKIPAHEAD;WHILE
NEXTCONTROL=137 DO SCANMODULE;UNTIL INPUTHASENDE;PHASEONE:=FALSE;STAT
MAXTOKPTR:=TOKPTR;TATS{98}IF TEXTLINK[0]=0 THEN BEGIN WRITELN(TTY);WRITE
(TTY,'! No output was specified.');END ELSE BEGIN WRITELN(TTY);WRITE(TTY
,'Writing the output file...');{69}STACKPTR:=1;BRACELEVEL:=0;CURSTATE.
NAMEFIELD:=0;CURSTATE.REPLFIELD:=TEXTLINK[0];CURSTATE.BYTEFIELD:=
TOKSTART[CURSTATE.REPLFIELD];CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.
REPLFIELD+1];{82}OUTSTATE:=0;OUTPTR:=0;BREAKPTR:=0;OUTBUF[0]:=0;LINE:=1;
SENDTHEOUTPU;{84}IF(OUTSTATE<>0)OR(OUTBUF[BREAKPTR]<>46)THEN BEGIN
WRITELN(TTY);WRITE(TTY,'! Program didn''t end with period');ERROR;END;
BREAKPTR:=OUTPTR;FLUSHBUFFER;WRITELN(TTY);WRITE(TTY,'Done.');END;9999:IF
STRINGPTR>128 THEN BEGIN WRITELN(TTY);WRITE(TTY,STRINGPTR-128:0,
' strings written to string pool file.');END;STAT{153}WRITELN(TTY);WRITE
(TTY,'Memory usage statistics:');WRITELN(TTY);WRITE(TTY,NAMEPTR:0,
' names, ',TEXTPTR:0,' replacement texts;');WRITELN(TTY);WRITE(TTY,
BYTEPTR:0,' bytes, ',MAXTOKPTR:0,' tokens.');TATS END.